perm filename JUSTJ.F4[NEW,LCS] blob
sn#513498 filedate 1980-05-29 generic text, type T, neo UTF8
C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
DATA RBX/6.0/,RBZ/8.0/,SPFAC/0.20/
DO 11 KN=0,JLP
RSPC=0
R8=KN
N=0
DO 2 K=1,KY
L=NP(K)
RL=RN(L)
C RL=WDCNT-2
RA=RN(L+1)
C RA=CODE NUM.
RB=RN(L+3)
C RB=POSITION(P3)
IF(RN(L+2).EQ.R8)GO TO 77
C THIS STAFF?
IF(RA.NE.4)GO TO 2
C SKIPS HOMED NOTES (IN CHORDS)
77 IF(RA.LT.3)GO TO 20
IF(RA.EQ.4)GO TO 444
IF(RA.EQ.3)GO TO 333
C LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
C*** CAN'T WORK YET ***** IF(RA.LT.16)GO TO 2
IF(RA.LT.17)GO TO 2
GO TO 10
333 IF(RL.LT.3)GO TO 10
C <3 MEANS NOTHING IN P5
IF(RN(L+5).GT.4)GO TO 2
C NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
GO TO 10
444 IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 2
C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
CC FOR REPEAT BAR WDCNT IS 3 -- 10/77 444 IF(RL.GT.2)GO TO 2
C SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
GO TO 10
20 IF(RA.NE.2)GO TO 113
C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
IF(RN(L+6))GO TO 2
IF(RN(L+7))GO TO 2
C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
GO TO 10
113 IF(RL.LT.7)GO TO 10
C NOW NOTES. SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
IF(RN(L+9).LT.0)GO TO 2
10 N=N+1
R(1,N)=RB
IR(2,N)=L
IF(N.EQ.250)GO TO 28
C ONLY TREATS 250 ITEMS AT A TIME.
2 CONTINUE
IF(N.EQ.0)GO TO 11
28 DO 23 K=1,N
23 IF(RN(IR(2,K)+1).NE.4)GO TO 24
C SKIPS IF ONLY BAR LINES ON THIS STAFF
GO TO 11
24 RSZ=RSTFAC(KN)*PRCNT
CALL SORT2(R,N)
C JUMP IF LAST IS A BAR LINE.
K=0
JLDGR=0
JX=0
22 K=K+1
122 L=IR(2,K)
RA=RN(L+1)
C RA IS NOW CODE NUM.
RL=RN(L)
C RL=WDCNT-2
RB=0
RD=0
C RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
RX=RN(L+5)
C RX=PARAM 5
RX6=RN(L+6)
RY=1
RW=AMOD(RN(L+4),100.)
RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
IF(RA.GT.1)GO TO 4
RZ=RN(L+7)
IF(LDGR.NE.JLDGR)JLDGR=0
C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
LDGR=0
JK=K
DO 32 JJ=JK+1,N+1
K=JJ
RB=R(1,JJ)-R(1,JJ-1)
IF(RB.GT.0.1)GO TO 320
C PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
R(1,JJ)=R(1,JJ-1)
GO TO 32
320 IF(RB.GT.RSP)GO TO 35
32 CONTINUE
C FOUND HOW MANY MEMBERS TO CHORD.
35 RB=0
K=K-1
RQ=0
125 RC=ABS(RN(L+4))
IF(RC.LT.60)GO TO 637
IF(RC.LT.180)RY=.6
C FOUND A MINI-NOTE
637 RSDF=0
IF(RA.EQ.1)GO TO 437
C JUMP IF NOTE
RDF=-1
C NOW IT'S ANYTHING BUT A NOTE
GO TO 137
437 IF(RL.LT.8)GO TO 237
C JUMP IF THERE IS NOT P10 TO LOOK AT
RW=RN(L+10)
C PUT P10 INTO RW
GO TO 337
237 RW=0
337 IF(RDF.LT.0)GO TO 537
C JUMP IF PREVIOUS WAS NOT A NOTE
IF(RW.EQ.RDF)GO TO 137
C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
RSDF=-1
537 RDF=RW
C SAVE STAFF INFO FOR NEXT TIME AROUND.
137 DO 37 JJ=JK,K
C******* IF(RD.NE.0)GO TO 38
C FINDS ONLY HIGH OR! LOW LED. LINE.
JR=IR(2,JJ)
RW=AMOD(RN(JR+4),100.)
IF(RW.GT.12)GO TO 277
IF(RW.GE.2)GO TO 38
277 LDGR=-1
IF(RW.GT.11)LDGR=1
IF(JLDGR.EQ.LDGR)GO TO 36
JLDGR=LDGR
C LDGR IS FOR LEDGER LINES.
GO TO 38
36 IF(RD.GE.1.5)GO TO 38
RD=1.5
RQ=RD
38 IF(RB.GT.2)GO TO 222
C JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
RZZ=RN(JR+7)
RE=RN(JR+5)
IF(RB.GE.2)GO TO 477
RC=1.5
IF(RZZ.LT.10)GO TO 378
IF(RZZ.GE.20)RC=3.
C 10=DOT, 20=DOUBLE DOT
GO TO 377
378 IF(RE.GE.20)GO TO 477
IF(AMOD(RZZ,10.).EQ.0)GO TO 477
377 RB=RC+EXTEN(RZZ)
C SPACE FOR DOT OR TAIL(IF STEM UP)
477 IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
C FOR CHORD TONES ON RIGHT OF STEM UP.
C LOOKS THROUGH ALL NOTES OF A CHORD.
222 RC=AMOD(RE,10.0)
IF(RC.EQ.0)GO TO 37
C JUMP IF NO ACCIS. NOW SEE IF THERE'S SPACE FOR ACCI.
IF(RN(JIR+1).NE.1)GO TO 425
C* RX=0
C* IF(RN(JR).GE.8)RX=RN(JR+10)
C* RXX=0
C* IF(RN(JIR).GE.8)RXX=RN(JIR+10)
C* RDF=0
C* IF(RX.NE.RXX)RDF=100.
C SAVE INFO ON NOTES ON DIFF. STAVES.
C* IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
C JIR IS POINTER TO PREVIOUS ITEM. SKIP IF NOT A NOTE.
KX=RC
C KX=ACCI ON CURRENT NOTE
RD=1
C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
RX=RN(L+4)
RXX=ABS(RX)
C THIS NOTE
577 IF(RXX.LT.80)GO TO 677
C FIND MINIS, HARMONICS, ETC.
RXX=RXX-100
GO TO 577
677 IF(RX)RXX=-RXX
RX=RXX
RDIF=RN(JIR+4)
RXX=ABS(RDIF)
777 IF(RXX.LT.80)GO TO 877
C FIND MINIS, HARMONICS, ETC.
RXX=RXX-100
GO TO 777
877 IF(RDIF)RXX=-RXX
RDIF=RX-RXX
C HEIGHT DIFF. JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
RX=3
JSTM=RN(JIR+5)/10.0
C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
IF(RDIF.GT.0)GO TO 427
C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
IF(JSTM.NE.2)GO TO 424
IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL. THEN WE NEED SPACE.
424 IF(KX.NE.2)RX=5
GO TO 428
427 IF(KX.EQ.2)RX=4
C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
428 IF(ABS(RDIF).LT.RX)GO TO 425
IF(RDIF)GO TO 426
C JUMP IF THIS NOTE IS LOWER THAN PREV.
IF(JSTM.NE.1)GO TO 426
C NO BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.
425 RW=2.8
IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
CATCHES DOUBLE FLAT (=4)
RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425 RD=2*RY+EXTEN(RE)
426 IF(RQ.GT.RD)RD=RQ
RQ=RD
C FUNCT. EXTEN=AMOD(X,1.)*10.
37 CONTINUE
IF(RY.NE.1)RB=RB-.5*RJSZ
C MINI NOTES NEED LESS SPACE
250 IF(RSDF)GO TO 17
ACCX=0
CC RC=0
JIR=JX+2
IF(JIR.GE.N)GO TO 25
RW=R(1,JIR-1)
DO 132 JJ=JIR,N
IF(RW.NE.R(1,JJ))GO TO 25
KX=IR(2,JJ)
C GET POINTER
IF(RN(KX+1).NE.1)GO TO 25
C ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
CC RE=ABS(RN(KX+6))
CC IF(RE.GE.10)RC=-2.6
CC IF(RE.EQ.20)RC=-RC
RC=OTHSID(RN,KX)
RE=AMOD(RN(KX+5),10.0)
C FIND AN ACCI
IF(RE.GE.1)RC=RC+2
IF(IFIX(RE).EQ.4)RC=RC+2
C FOUND AN ACCI RE=4=DOUBLE FLAT
RC=AMOD(RE,1.0)*10.0+RC
C ADD ANY EXTENSION TO THE LEFT
IF(RC.GT.ACCX)ACCX=RC
CC RC=0
IF(ACCX.GT.RD)RD=ACCX
132 CONTINUE
GO TO 25
4 IF(RA.NE.2)GO TO 33
C NEXT FOR DOTTED RESTS - IN P6
IF(RL.LT.6.)GO TO 44
IF(RN(L+8).LT.0)GO TO 250
C P8=-1 MEANS WHOLE MEASURE REST (NEVER DOT, P6 CAN HAVE NUMB.)
44 IF(RL.GE.4)RB=RN(L+6)*1.5
C NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
GO TO 250
33 IF(RA.NE.3)GO TO 29
RB=3
IF(RN(L+4).GT.80)RB=1.5
C CHECK ON SIZE NEEDED FOR CLEFS. >80 = MINICLEF
GO TO 17
C NEXT STILL NEEDS WORK (BAR LINES SOMETIMES NOT ON CURRENT STAFF!!)
IF(JX.EQ.0)GO TO 17
IF(RN(JIR).EQ.4.)GO TO 17
C JUMP IF THIS IS FIRST ITEM OR PREVIOUS ITEM WAS BAR LINE
C RC = NEEDED SPACE FROM PREVIOUS ITEM (SETUP AT 17)
IF(R(1,K+1)-R(1,K).LT.RC)GO TO 17
C JUMP IF NOT REALLY ENOUGH SPACE FOR CLEF
JIR=L+3
RD=RN(JIR)-R(1,K-1)
C RD=SPACE FROM PREV. ITEM TO CLEF
IF(RD.GE.RC)GO TO 17
C ALREADY ENOUGH SPACE TO LEFT OF CLEF
RC=RN(JIR)+RC-RD
C NOW NOT ENOUGH TO LEFT BUT PLENTY TO RIGHT - SO MOVE CLEF TO RIGHT
RN(JIR)=RC
R(1,K)=RC
C RESET POSITION LOCATIONS
RB=0
GO TO 17
29 IF(RA.NE.4)GO TO 26
C BAR LINES
IF(RN(L+4).LT.0)GO TO 17
C SKIP IF INVISIBLE BAR LINE (FOR PAGE PROGRAM )
RB=-RJSZ/2
RD=.9
KX=RN(L+4)/1000.
IF(KX.LE.0.)GO TO 25
RD=RD+1.2
C ADD A LITTLE SPACE IN FRONT OF DBL BAR.
IF(KX.GT.1)GO TO 229
IF(RL.LT.3)GO TO 25
C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN P5.
CCC IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
229 IF(KX.NE.2)RD=RD+RD
C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
C REPT BAR WITH DOTS TO LEFT. ADD SPACE IN FRONT OF IT.
RB=-RB/RBX
IF(KX.EQ.4)KX=0
129 IF(KX.GE.2)RB=RBZ*RB
C IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
GO TO 25
26 IF(RA.NE.18)GO TO 30
C METER
RC=0
IF(RL.GE.7)RC=9
C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
RB=-1
RD=1
IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
C CHECKS FOR 2-DIGIT METERS
RD=2
RB=0
31 RB=RB+RC
GO TO 25
30 IF(RA.NE.17)GO TO 17
C30 IF(RA.NE.16)GO TO 34
C IF(RL.GE.8.0)GO TO 3 ***THIS NEXT CAN'T WORK YET ****
C P10 MUST =0 *** BECAUSE NO INFO IN P9 WITH SHORT GROUPS ***
C RC=R(1,N)
C P3 POSITION
C KY=L
C RX=0
C DO 134 KX=1,N
C L=IR(2,KX)
C IF(RN(L+1).NE.16.0)GO TO 134
C SKIP IF NEXT IS NOT WORD
C RW=0
C IF(RC.LE.RN(L+3))GO TO 134
C SKIP IF WORD IS TO RIGHT OF NEXT WORD
C334 RW=RW+RN(KY+9)
C UPDATE SPACE NEEDED (IN P9)
C IF(RN(KY+10).NE.16.0)GO TO 234
C JUMP OUT IS NEXT IS NOT WORD
C KY=KY+9
C IF(RN(KY).LE.7.0)GO TO 234
C JUMP OUT IF NEXT STARTS NEW GROUP OF CHARS.
C KY=KY+1
C GO TO 334
C234 RW=RN(L+3)+RW*RSZ
C NOW RW GIVES END POINT OF GROUP
C IF(RW.GT.RX)RX=RW
C RX IS POINT FOR COMPARISON (CAN OVERLAP)
C134 CONTINUE
C IF(RX.EQ.0.OR.RC-RX.GE.RSP)GO TO 3
C GO TO 3 IF ENOUGH SPACE ALREADY
C GO TO 25
C34 IF(RA.NE.17)GO TO 17
C KSIG
RX=ABS(RX)
IF(RX.GE.100)RX=RX-100
C +100 FOR NATURALS AS KEYSIG.
RB=2*(RX-1)-2
C SPACES FOR CORRECT NUM OF ACCIS. RX=NUM OF ACCIS.
RD=2
25 IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
17 RC=(RB+RJSZ)*RSZ
C RJSZ=DEFAULT SIZE
JIR=L
C SAVE THE POINTER FOR ACCI. CHECK AT 110
JX=K
R(2,JX)=RC
3 IF(K.LT.N)GO TO 22
RA=R(1,1)
RB=R(2,1)
DO 13 KX=2,JX
RE=R(1,KX)
C POS. BEFORE SHIFTING
IF(ABS(RE-RA).GT.RSP)GO TO 14
CCC IF(ABS(RE-RA).GT..5)GO TO 14
IF(R(2,KX).GT.RB)GO TO 16
C SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
GO TO 13
C JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
14 RD=RA+RB-RE
IF(RD.LE.0)GO TO 16
C THERE'S ENOUGH ROOM
ROV=ROV+RD
140 R4=RE+RSPC-.001
R5=10000
R8=RD
R9=0
C GO EXPAND IT
IF(R(2,KX).EQ.0)GO TO 15
CALL MOVIT(RN,NO,R4,R5,R8,R9)
C???? IF(R2.LE.4)GO TO 15
C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
IF(R2.LE.7)GO TO 15
R5=R4
R4=RA+.001+RSPC
R8=R4
R9=R5+RD-.001
C FOR ITEMS ON OTHER LINES.
CALL MOVIT(RN,NO,R4,R5,R8,R9)
15 RSPC=RSPC+RD
C RSPC SAVES TOTAL SPACE ADDED
16 RB=R(2,KX)
13 RA=RE
11 CONTINUE
END
FUNCTION OTHSID(RN,J)
DIMENSION RN(1)
OTHSID=0
A=ABS(RN(J+6))
IF(A.GE.10)OTHSID=-2.6
C OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
IF(A.GE.20)OTHSID=-OTHSID
END